home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / structs.h < prev    next >
C/C++ Source or Header  |  1992-10-06  |  15KB  |  617 lines
  1. /* ******************************************************************** */
  2. /*  structs.h        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Basic definitions of tags and structures                             */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, April 1989
  10.  *   added a little support for classes RJB
  11.  *   hacked it about a bit KJP
  12.  *   added semaphores KJP
  13.  */
  14.  
  15. #ifndef STRUCTS_H
  16. #define STRUCTS_H
  17.  
  18. #include <stdio.h>
  19.  
  20. #ifdef WITH_BIGNUMS
  21. #include "BigZ.h"
  22. #endif
  23. #undef BIGNUM
  24.  
  25. #ifndef SETJMP_H
  26. #define SETJMP_H
  27. #include <setjmp.h>
  28. #endif
  29.  
  30. /* Load system types... */
  31.  
  32. #include "system_t.h"
  33.  
  34. /*#include "compact.h"*/
  35. /* Primitive types... */
  36.  
  37. /* indiacte that ob can be swept */
  38. /* note that the bignum typeof operation may need to be changed 
  39.    plus some comparisons in arith.c --- unless we do them right
  40.    --- pab */
  41.  
  42. #define CALLABLE_TYPE 0x100
  43. #define MACRO_TYPE    0x200
  44.  
  45. #define TYPE_UNUSED     -1
  46.  
  47. #define TYPE_ENV    0xe0
  48.  
  49. #define TYPE_CONS    0x1
  50. #define TYPE_CHAR    (0x2)
  51. #define TYPE_STRING    (0x3)
  52. #define TYPE_TABLE    (0x5)
  53. #define TYPE_SYMBOL     (0x6)
  54. #define TYPE_THREAD    (0xb)
  55. #define TYPE_STREAM    (0xc)
  56. #define TYPE_CLASS    (0xd)
  57. #define TYPE_INSTANCE    (0xe)
  58. #define TYPE_SPECIAL    (0xf)
  59. #define TYPE_VECTOR    0x10
  60.  
  61. #define TYPE_INT    (0x11)
  62. #define TYPE_RATIONAL    (0x14)
  63. #define TYPE_FLOAT    (0x15)
  64. #define TYPE_COMPLEX    (0x16)
  65. #define TYPE_BIGNUM     (0x17)
  66. #define TYPE_LASTNUMBER 0x2f
  67.  
  68. #define TYPE_CONTINUE    (0x30)
  69.  
  70. #define TYPE_C_MODULE   (0x40)
  71. #define TYPE_I_MODULE   (0x50)
  72. #define TYPE_C_FUNCTION (0x60 | 0x100)
  73. #define TYPE_I_FUNCTION (0x61 | 0x100)
  74. #define TYPE_METHOD     0x62
  75. #define TYPE_GENERIC    (0x63 | 0x100)
  76.  
  77. #define TYPE_C_MACRO    (0x70 | 0x200)
  78. #define TYPE_I_MACRO    (0x71 | 0x200)
  79.  
  80. #define TYPE_SEMAPHORE  (0x90)
  81. #define TYPE_LISTENER   (0xa0)
  82. #define TYPE_SOCKET     (0xa1)
  83. #define TYPE_NULL       (0xb0)
  84. #define TYPE_WEAK_WRAPPER 0xc0
  85.  
  86. #define TYPE_B_FUNCTION (0x7a | 0x100)
  87. #define TYPE_B_MACRO    (0x7b | 0x200)
  88.  
  89. /* Plural Hacks */
  90. /* ====== ===== */
  91.  
  92. #define TYPE_STRANGE (0xa5)
  93.  
  94. /* Primitive accessors... */
  95. #ifdef NOLOWTAGINTS
  96. #define typeof(p)      ((p)->OBJECT.header.type)
  97. #define classof(p)      ((p)->OBJECT.header.class)
  98. #else
  99. #define typeof(p)       (((int)p) & 1 ? TYPE_INT: ((p)->OBJECT.header.type))
  100. #define classof(p)     (((int)p) & 1 ? Integer: ((p)->OBJECT.header.class))
  101. #endif
  102. #define type_of(p)      typeof(p)
  103. #define gcof(p)         (((p)->OBJECT).header.gc)
  104. #define gc_of(p)        gcof(p)
  105. #define lval_classof(p)  ((p)->OBJECT.header.class)
  106. #define lval_typeof(p)   ((p)->OBJECT.header.type)
  107.  
  108. #define class_of(p)     classof(p)
  109.  
  110. /* Primitive type testers... */
  111.  
  112. #define is_cons(p)      (typeof(p) == TYPE_CONS)
  113. #define is_char(p)      (typeof(p) == TYPE_CHAR)
  114. #define is_string(p)    (typeof(p) == TYPE_STRING)
  115. #define is_table(p)     (typeof(p) == TYPE_TABLE)
  116. #define is_symbol(p)    (typeof(p) == TYPE_SYMBOL)
  117. #define is_function(p)  (typeof(p) & CALLABLE_TYPE)
  118. #define is_macro(p)     (typeof(p) & MACRO_TYPE)
  119. #define is_module(p)    ((typeof(p) == TYPE_I_MODULE)  | \
  120.              (typeof(p) == TYPE_C_MODULE))
  121. #define is_special(p)   (typeof(p) == TYPE_SPECIAL)
  122. #define is_thread(p)    (typeof(p) == TYPE_THREAD)
  123. #define is_stream(p)    (typeof(p) == TYPE_STREAM)
  124. #ifdef NOLOWTAGINTS
  125. #define is_fixnum(p)    (typeof(p) == TYPE_INT)
  126. #else
  127. #define is_fixnum(p)    (((int) (p)) &1)
  128. #define mk_fixnum(x)     ((LispObject) (((x)<<1) | 1))
  129. #endif
  130.  
  131. #define is_bignum(p)    (typeof(p) == TYPE_BIGNUM)
  132. #define is_float(p)     (typeof(p) == TYPE_FLOAT)
  133. #define is_vector(p)    (typeof(p) == TYPE_VECTOR)
  134. #define is_continue(p)    (typeof(p) == TYPE_CONTINUE)
  135.  
  136.  
  137.  
  138. #define is_c_function(p) (typeof(p) == TYPE_C_FUNCTION)
  139. #define is_c_module(p)  (typeof(p) == TYPE_C_MODULE)
  140. #define is_i_function(p) (typeof(p) == TYPE_I_FUNCTION)
  141. #define is_i_module(p)  (typeof(p) == TYPE_I_MODULE)
  142. #define is_c_macro(p)   (typeof(p) == TYPE_C_MACRO)
  143. #define is_i_macro(p)   (typeof(p) == TYPE_I_MACRO)
  144. #define is_b_function(p) (typeof(p)==TYPE_B_FUNCTION)
  145. #define is_b_macro(p)    (typeof(p) == TYPE_B_MACRO)
  146.  
  147. #define is_semaphore(p) (typeof(p) == TYPE_SEMAPHORE)
  148. #define is_listener(p)  (typeof(p) == TYPE_LISTENER)
  149. #define is_socket(p)    (typeof(p) == TYPE_SOCKET)
  150. #define is_weak_wrapper(p) (typeof(p) == TYPE_WEAK_WRAPPER)
  151.  
  152. #define is_e_function(p) (0)
  153. #define is_e_macro(p) (0)
  154.  
  155. /* Other macros... */
  156.  
  157. #define null(p)      ((LispObject)(p) == nil)
  158. #define consp(p)     (is_cons(p) && (p) != nil)
  159. #define symbolp(p)   (is_symbol(p) || (p) == nil)
  160. #define CAR(p)         (((p)->CONS).car)
  161. #define CDR(p)         (((p)->CONS).cdr)
  162. #define classp(p)    (typeof(p) & 0x2000)
  163. #define is_number(p) (typeof(p) >= TYPE_INT && typeof(p) <= TYPE_LASTNUMBER)
  164.  
  165. /* Evils for the garbage collector */
  166.  
  167. #define is_forwarded(x) \
  168.   (gcof(x))&0x1
  169.   
  170. #define forwardof(x) \
  171.   (classof(x))
  172.  
  173. #define set_forwarded(x, new) \
  174.   ( *(&gcof(x))|=1 , forwardof(x)=new)
  175.  
  176. typedef union lispunion *LispObject;
  177.  
  178. /* GC used object... */
  179.  
  180. struct hunk_structure {
  181.   short        type;
  182.   short        gc;
  183.   LispObject   next_hunk;
  184.   int          hunk_size;
  185. };
  186.  
  187. typedef struct Object_struct
  188. {
  189.   short type;
  190.   short gc;
  191.   LispObject class;
  192. } Object_t;
  193.  
  194. struct envobject {
  195.   Object_t        header;
  196.   LispObject        variable;
  197.   LispObject        value;
  198.   struct envobject *    next;
  199.   LispObject        mutable;
  200. };
  201.  
  202. typedef struct envobject *Env;
  203.  
  204. /* the top most class object */
  205.  
  206. struct object_structure {
  207.   Object_t    header;
  208.   LispObject    slots[1];    /* the other slots */
  209. };
  210.  
  211.  
  212. struct integer_structure {
  213.   Object_t     header;
  214.   int        value_part;
  215. };
  216. #ifdef NOLOWTAGINTS
  217. #define intval(x) ((x)->INT.value_part)
  218. #else
  219. #define intval(x) (((int)x)>>1)
  220. #endif
  221.  
  222. /* low tag ints */
  223.  
  224.  
  225.  
  226. struct float_structure {
  227.   Object_t     header;
  228.   double    fvalue;
  229. };
  230.  
  231. struct bignum_structure {
  232. Object_t header;
  233. #ifdef WITH_BIGNUMS
  234.   BigZ          value;
  235. #endif
  236.  
  237.   int *         bnum;
  238. };
  239.  
  240. struct complex_structure {
  241.   Object_t header;
  242.   LispObject    real;
  243.   LispObject    imaginary;
  244. };
  245.  
  246. struct ratio_structure {
  247.   Object_t header;
  248.   LispObject    numerator;
  249.   LispObject    denominator;
  250. };
  251.  
  252. struct character_structure {
  253.   Object_t header; 
  254.   unsigned char    font;
  255.   unsigned char    code;
  256. };
  257.  
  258. struct symbol_structure {
  259.   Object_t    header;
  260.   LispObject    lmodule;  /* Module lookup cache for the interpreter */
  261.   LispObject    lvalue;   /* Part II */
  262.   LispObject    gvalue;   /* Dynamic global value */
  263.   LispObject    plist;
  264.   int         hash;      /* hash value cache */
  265.   char *    pname;
  266.  
  267.   LispObject left;
  268.   LispObject right;
  269. };
  270.  
  271. /* comparator is a equality function, defaulting to Fn_equal,
  272.  * returning t or nil.
  273.  */
  274.  
  275. struct table_structure {
  276.   Object_t header; 
  277.   LispObject    (*comparator)(LispObject*);
  278.   LispObject    lisp_comparator;
  279.   LispObject    tree;
  280. };
  281.  
  282. /* This one is an internal type, used by tables and arrays.
  283.  * "base" is the first element in the array -- the others follow
  284.  * on directly --- note that this comment is carp (anag)
  285.  */
  286.  
  287.  
  288. #ifdef notdef /* Thu Oct 17 14:49:31 1991 */
  289. /**/
  290. /**/#define vref(v,n)  (*((v)->VECTOR.base + (n)))
  291. /**/#define vrefupdate(v,n,obj) (vref(v,n)=obj)
  292. #endif /* notdef Thu Oct 17 14:49:31 1991 */
  293.  
  294. #define vref(v,n) (*(&((v)->VECTOR.base) + (n)))
  295. #define vrefupdate(v,n,obj) (vref(v,n)=(obj))
  296. struct vector_structure {
  297.   Object_t header;
  298.   int length;            /* for now */
  299.   LispObject base;           
  300. };
  301.  
  302. #ifdef WITH_SMALL_CONSES
  303. struct cons_structure {
  304.   short        type;
  305.   short        gc;
  306.   LispObject    car;
  307.   LispObject    cdr;
  308. };
  309. #else
  310. struct cons_structure {
  311.   Object_t header;
  312.   LispObject    car;
  313.   LispObject    cdr;
  314. };
  315. #endif
  316.  
  317.  
  318. struct stream_structure {
  319.   Object_t header;
  320.   FILE*        handle;
  321.   LispObject    name;
  322.   int        curchar;
  323.   int        mode;
  324. };
  325.  
  326. struct string_structure {
  327.   Object_t header;
  328.   int length;
  329.   char value; /* really a c-string --- Should these be CHARs ?? */
  330. };
  331.  
  332. #define stringof(x)\
  333.   (&((x)->STRING.value))
  334.  
  335. struct funcallable_object_structure {
  336.   Object_t header;
  337.  
  338.   LispObject    (*cfun)();
  339.   LispObject    cfun_arg;
  340. };
  341.  
  342. struct continue_structure {
  343.   Object_t header;
  344.  
  345.   LispObject    value;     /* Returned with... */
  346.   LispObject    target;    /* When bouncing unwind protects... */
  347.  
  348.   LispObject    thread;
  349.  
  350.   LispObject  *gc_stack_pointer; /* Interpreter state */
  351.   Env           dynamic_env;
  352.   LispObject    last_continue;
  353.   LispObject    handler_stack;
  354.  
  355.   LispObject    dp;  /* Elvira state */
  356.  
  357.   /* Bytecode state? */
  358.  
  359.   jmp_buf       machine_state;
  360.  
  361.   int           live;
  362.   int           unwind;
  363.  
  364. };
  365.  
  366. struct thread_structure {
  367.   Object_t header;
  368.  
  369.   LispObject*  gc_stack_base;
  370.   
  371.  
  372.   LispObject     state;
  373.  
  374.   LispObject    fun;
  375.   LispObject    args;
  376.   LispObject    value;
  377.  
  378.   LispObject    parent;
  379.   LispObject    cochain;
  380.   int           status;
  381.   int           stack_size;
  382.   int           gc_stack_size;
  383.   int*          stack_base;
  384.  
  385. };
  386.  
  387. struct semaphore_structure {
  388.   Object_t header;
  389.   SystemSemaphore semaphore; /* Just a hacked wrapper */
  390. };
  391.  
  392. struct class_structure {
  393.   Object_t header;
  394.  
  395.   LispObject    name;           /* Name of the class (NOT binding name) */
  396.   LispObject    superclasses;  /* Direct parents */
  397.   LispObject    subclasses;    /* Direct subclasses */
  398.   LispObject    slot_table;    /* Table of slot descriptions */
  399.   LispObject    slot_list;     /* Slot list */
  400.   LispObject    direct_slot_list; /* Direct slot list */
  401.   LispObject    precedence;    /* Class precedence list */
  402. #ifdef notdef /* Thu Oct 17 14:50:09 1991 */
  403. /**/  LispObject    prototype;     /* Prototypical instance */ *
  404. #endif /* notdef Thu Oct 17 14:50:09 1991 */
  405.   int           local_count;   /* Number of local slots */
  406.  
  407. };
  408.  
  409. #define slotref(v,n)  (*(&((v)->INSTANCE.slots) + (n)))
  410. #define slotrefupdate(v,n,obj) (slotref(v,n)=obj)
  411.  
  412. struct instance_structure {
  413.   Object_t    header;
  414.   LispObject    slots;        /* Some structure of data */
  415. };
  416.  
  417.  
  418. /* Functions... */
  419.  
  420. /* Special forms are compiler only and don't have homes (?) */
  421.  
  422. struct special_structure {
  423.   Object_t header;
  424.   LispObject    name;
  425.   Env           env;
  426.   LispObject    (*func)();
  427. };
  428.  
  429. /* Basic function template to which all conform */
  430.  
  431. struct function_structure {
  432.   Object_t     header;
  433.   LispObject    name;      /* Original name in their module of origin */
  434.   LispObject    home;      /* Module of origin */
  435.   Env        env;       /* Defining parameter environment */
  436.   int        argtype;   /* Argument type code - unique for args */
  437. };
  438.  
  439. struct c_function_structure {
  440.   Object_t      header;
  441.   LispObject  name;
  442.   LispObject  home;
  443.   Env         env;
  444.  
  445.   int         argtype;
  446.   LispObject  (*func)();   /* Compiled functions just need fun pointer */
  447. };
  448.  
  449. struct i_function_structure {
  450.   Object_t    header;
  451.   LispObject    name;
  452.   LispObject    home;  
  453.   Env        env;
  454.  
  455.   int        argtype;    
  456.   LispObject    bvl;        /* Parameter list */
  457.   LispObject    body;           /* Body forms */
  458. };
  459.  
  460. /* Macros are a logical entity - being just specially interpretted functions */
  461.  
  462. struct generic_structure {   
  463.   Object_t     header;
  464.  
  465.   LispObject    name;
  466.   LispObject    home;
  467.   Env           env;           /* Redundant, I think */
  468.   int           argtype;
  469.  
  470.   LispObject    method_class;
  471.   LispObject    discriminator;
  472.   LispObject    cache_table;
  473.   LispObject    method_table;  /* Like it says */
  474. };
  475.  
  476. /* Methods AREN'T FUNCTIONS ! */
  477.  
  478. struct method_structure {
  479.   Object_t header;
  480.  
  481.   LispObject    qualifier;     /* Whatever that may be */
  482.   LispObject    signature;     /* Class list up to any n-ary bit */
  483.   LispObject    host;          /* Generic function ( nil => unatached ) */
  484.   LispObject    function;      /* The actual function */
  485.   LispObject           fixed;         /* Detatchable or not */
  486. };
  487.  
  488. /* Module structures */
  489.  
  490. /* Template for all types - an abstract class like function */
  491.  
  492. struct module_structure {
  493.   Object_t      header;
  494.   LispObject  name;              /* Symbol */
  495.   LispObject  home;              /* In ? */
  496.   LispObject  imported_modules;  /* Module dependecies - name list */
  497.   LispObject  exported_names;    /* Name list too */
  498.   LispObject  bindings;
  499. };
  500.  
  501. struct c_module_structure {
  502.   Object_t    header;
  503.   LispObject  name;
  504.   LispObject  home;
  505.   LispObject  imported_modules;
  506.   LispObject  exported_names;
  507.   LispObject  bindings;
  508.   
  509.   LispObject* values;            /* Value vector of static module */
  510.   LispObject  (**functions)();   /* Function vector */
  511.   int         entry_count;       /* Useful thing */
  512. };
  513.  
  514. typedef struct c_module_structure MODULE;
  515.  
  516. struct i_module_structure {
  517.   Object_t     header;
  518.   LispObject   name;
  519.   LispObject   home;
  520.   LispObject   imported_modules;      
  521.   LispObject   exported_names;        
  522.   LispObject   bindings;
  523.  
  524.   int          bounce_flag;
  525. };
  526.  
  527. /* Sockets support... */
  528.  
  529. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  530.  
  531. #include "syssockets.h"
  532.  
  533. struct listener_structure {
  534.   Object_t header;
  535.   
  536.   SocketHandle   socket;
  537.   SocketInName   name;
  538.  
  539.   int            state;
  540. };
  541.  
  542. struct socket_structure {
  543.   Object_t      header;
  544.  
  545.   SocketHandle   socket;
  546.   SocketInName   name;
  547.  
  548.   char           buffer[SOCKET_BUFFER_SIZE]; /* Input buffer */
  549.  
  550.   int            state;
  551. };
  552.  
  553. #endif
  554.  
  555. /* Structure for extensiblility without hacking... */
  556.  
  557. struct c_object_structure {
  558.   Object_t header;
  559.  
  560.   LispObject  *slots;        /* LispObject slot vector - garbage protected */
  561.   char        first_c_byte; /* Start of C-data, unprotected */
  562. };
  563.  
  564. /* Weak wrappers... */
  565.  
  566. struct weak_wrapper_structure {
  567.   Object_t header;
  568.   LispObject  object;
  569. };
  570.  
  571. union lispunion {
  572.   struct hunk_structure         HUNK;
  573.   struct object_structure    OBJECT;
  574.   struct integer_structure    INT;
  575.   struct float_structure    FLOAT;
  576.   struct bignum_structure    BIGNUM;
  577.   struct complex_structure    COMPLEX;
  578.   struct ratio_structure    RATIO;
  579.   struct character_structure    CHAR;
  580.   struct symbol_structure    SYMBOL;
  581.   struct table_structure    TABLE;
  582.   struct cons_structure        CONS;
  583.   struct stream_structure    STREAM;
  584.   struct string_structure       STRING;
  585.   struct thread_structure       THREAD;
  586.   struct semaphore_structure    SEMAPHORE;
  587.   struct class_structure    CLASS;
  588.   struct instance_structure    INSTANCE;
  589.   struct vector_structure       VECTOR;
  590.   struct continue_structure    CONTINUE;
  591.   struct envobject        ENV;
  592.   struct special_structure      SPECIAL;
  593.   struct function_structure     FUNCTION;
  594.   struct c_function_structure   C_FUNCTION;
  595.   struct i_function_structure   I_FUNCTION;
  596. /**  struct generic_structure      GENERIC; */
  597.   struct function_structure     MACRO;
  598.   struct c_function_structure   C_MACRO;
  599.   struct i_function_structure   I_MACRO;
  600. /**   struct method_structure       METHOD; */
  601.   struct module_structure       MODULE;
  602.   struct c_module_structure     C_MODULE;
  603.   struct i_module_structure     I_MODULE;
  604. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  605.   struct listener_structure     LISTENER;
  606.   struct socket_structure       SOCKET;
  607. #endif 
  608.   struct c_object_structure     C_OBJECT;
  609.   struct weak_wrapper_structure WEAK_WRAPPER;
  610. };
  611.  
  612. #include "system_p.h"
  613.  
  614. #endif /* STRUCTS_H */
  615.  
  616. /* End of structs.h */
  617.